home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / PCQ-ILBM-Kurs / LoadIFF.p next >
Encoding:
Text File  |  1997-05-06  |  11.7 KB  |  519 lines
  1. PROGRAM LoadIFF;
  2.  
  3. {
  4.   Demoprogramm für den IFF-PCQ-Kurs im AmigaGadget
  5.  
  6.   Funktion : kann vom CLI aus mit "IFFKurs Filename" aufgerufen werden
  7.              und zeigt dann das File "Filename" an, sofern es sich dabei
  8.              um ein IFF-ILBM-Bild handelt
  9.              es werden nur die allernotwendigsten Chunks unterstützt,
  10.              Overscan-Support oder ähnliches fehlt ebenso
  11.  
  12.   © 1995 by Andreas Neumann basierend auf einer Veröffentlichung von
  13.             Fritjof Siebert und den Informationen auf den
  14.             CATS-IFF-Entwickler-Disks
  15. }
  16.  
  17. {$I "Include:Exec/Exec.i" }
  18. {$I "Include:Hardware/IntBits.I" }
  19. {$I "Include:libraries/Dosextens.I" }
  20. {$I "Include:Graphics/Graphics.I" }
  21. {$I "Include:Graphics/View.i" }
  22. {$I "Include:Graphics/Blitter.i" }
  23. {$I "Include:Graphics/GfxBase.i" }
  24. {$I "Include:graphics/Pens.i" }
  25. {$I "Include:Graphics/Rastport.i" }
  26. {$I "Include:Intuition/intuition.i" }
  27. {$I "Include:Intuition/Intuitionbase.i" }
  28. {$I "Include:Utils/StringLib.i" }
  29. {$I "Include:Utils/Parameters.I" }
  30.  
  31.  
  32. TYPE
  33.     IFFTitles = (BMHD_f,CMAP_f,CAMG_f,BODY_f);
  34.  
  35.     BMHD = RECORD
  36.             width,
  37.             height      : SHORT;
  38.             depth       : BYTE;
  39.             left,
  40.             top         : SHORT;
  41.             masking     : BYTE;
  42.             transCol    : SHORT;
  43.             xAspect,
  44.             yAspect     : BYTE;
  45.             scrnWidth,
  46.             scrnHeight  : SHORT;
  47.            END;
  48.  
  49.     CMAP = RECORD
  50.             colorcnt    : SHORT;
  51.             red,
  52.             green,
  53.             blue        : ARRAY [0..255] OF BYTE;
  54.            END;
  55.  
  56.     CAMG = RECORD
  57.             viewType    : INTEGER;
  58.            END;
  59.  
  60.     IFFInfoType = RECORD
  61.                    IFFBMHD  : BMHD;
  62.                    IFFCMAP  : CMAP;
  63.                    IFFCAMG  : CAMG;
  64.                    IFFTitle : IFFTitles;
  65.                   END;
  66.  
  67.     IFFInfoTypePtr = ^IFFInfoType;
  68.  
  69.     IFFErrors = (iffNoErr,iffOutOfMem,iffOpenScreenfailed,
  70.                  iffOpenWindowFailed,iffOpenFailed,iffWrongIff,
  71.                  iffReadWriteFailed);
  72.  
  73.  
  74. CONST
  75.  
  76.     gfxname : String = ("graphics.library");
  77.  
  78.     { IFFError-Strings }
  79.  
  80.     IFFErrorStrings : ARRAY [iffNoErr..iffReadWriteFailed] OF String =
  81.                         ("No Error","Out of Memory","OpenScreen failed",
  82.                          "OpenWindow failed","Open Failed","Wrong Iff",
  83.                          "ReadWrite failed");
  84.  
  85.  
  86. VAR
  87.     IFFError    :   IFFErrors;
  88.     IFFInfo     :   IFFInfoType;
  89.     IFFName     :   String;
  90.     IFFScreen   :   ScreenPtr;
  91.     IFFWindow   :   WindowPtr;
  92.     IFFMes      :   IntuiMessagePtr;
  93.  
  94. {$A     XREF    _p%IntuitionBase    }
  95.  
  96.  
  97. FUNCTION Hoch (basis : INTEGER; exp : INTEGER) : INTEGER;
  98.  
  99. VAR h1 : INTEGER;
  100.     h2 : INTEGER;
  101.  
  102. BEGIN
  103.  h1:=1;
  104.  IF exp>0 THEN
  105.   FOR h2:=1 TO exp DO
  106.    h1:=h1*basis;
  107.  Hoch:=h1;
  108. END;
  109.  
  110.  
  111. FUNCTION GetIBase : IntuitionBasePtr;
  112.  
  113. BEGIN
  114. {$A
  115.         move.l  _p%IntuitionBase,d0
  116. }
  117. END;
  118.  
  119.  
  120. FUNCTION IsAGA (gb : GfxBasePtr) : BOOLEAN;
  121.  
  122. BEGIN
  123.  IF (gb^.ChipRevBits0 AND %100)=%100 THEN
  124.   IsAGA:=TRUE
  125.  ELSE
  126.   IsAGA:=FALSE;
  127. END;
  128.  
  129.  
  130. PROCEDURE MySetRGB (vp : ViewPortPtr ; nr , r , g , b : INTEGER ;
  131.                     gb : GfxBasePtr);
  132.  
  133. BEGIN
  134.  IF IsAGA (gb) THEN
  135.   SetRGB32 (vp,nr,r shl 24,g shl 24,b shl 24)
  136.  ELSE
  137.  SetRGB4 (vp,nr,(r shr 4),(g shr 4),(b shr 4));
  138. END;
  139.  
  140. PROCEDURE BufSkip (VAR bufptr : Address ; bytes : INTEGER);
  141.  
  142. BEGIN
  143.  bufptr:=Address(Integer(bufptr)+bytes);
  144. END;
  145.  
  146.  
  147. FUNCTION ReadILBM (name : String; VAR myscreen : ScreenPtr ;
  148.                    VAR mywindow : WindowPtr) : BOOLEAN;
  149.  
  150. VAR Compression,
  151.     MaskPlane,
  152.     contload        :   BOOLEAN;
  153.     LineLength,
  154.     LineWidth,
  155.     i,
  156.     j,
  157.     k,
  158.     len,
  159.     PictureLength   :   INTEGER;
  160.     PictureBuffer,
  161.     WorkBuffer,
  162.     HeaderBuffer    :   Address;
  163.     TextBuffer      :   String;
  164.     LONGBuffer      :   ^ARRAY [0..63] OF INTEGER;
  165.     SHORTBuffer     :   ^ARRAY [0..127] OF SHORT;
  166.     BYTEBuffer      :   ^ARRAY [0..255] OF BYTE;
  167.     InH             :   FileHandle;
  168.     IFFBitMap       :   BitMapPtr;
  169.  
  170.  
  171. PROCEDURE OpenScrn;
  172.  
  173. VAR nuscreen    :   NewScreen;
  174.     nuwindow    :   NewWindow;
  175.     i           :   INTEGER;
  176.  
  177. BEGIN
  178.  WITH NuScreen DO
  179.  BEGIN
  180.   width:=IFFInfo.IFFBMHD.scrnWidth;
  181.   IF width<IFFInfo.IFFBMHD.width THEN
  182.    width:=IFFInfo.IFFBMHD.width;
  183.   height:=IFFInfo.IFFBMHD.scrnHeight;
  184.   IF height<IFFInfo.IFFBMHD.height THEN
  185.    height:=IFFInfo.IFFBMHD.height;
  186.  
  187.   leftEdge:=IFFInfo.IFFBMHD.left;
  188.   topEdge:=IFFInfo.IFFBMHD.top;
  189.  
  190.   depth:=IFFInfo.IFFBMHD.depth;
  191.   viewModes:=0;
  192.   IF width>=640 THEN ViewModes:=ViewModes OR HIRES;
  193.   IF height>=400 THEN ViewModes:=ViewModes OR LACE;
  194.  
  195.   WITH IFFInfo.IFFCAMG DO
  196.    ViewModes:=ViewModes OR ViewType;
  197.  
  198.   IF ((depth=6) OR (depth=8)) AND (ViewModes=0) THEN
  199.   IF (IFFInfo.IFFCMAP.colorcnt=Hoch(2,depth-2)) THEN
  200.    ViewModes:=HAM;
  201.  
  202.   IF ((ViewModes AND HAM)=HAM) AND
  203.      (IFFInfo.IFFCMAP.colorcnt>Hoch(2,depth-2)) THEN
  204.    IFFInfo.IFFCMAP.colorcnt:=Hoch(2,depth-2);
  205.  
  206.   detailPen:=0;
  207.   blockPen:=0;
  208.   stype:=CUSTOMSCREEN_f+SCREENQUIET_f+SCREENBEHIND_f;
  209.   font:=NIL;
  210.   defaultTitle:=NIL;
  211.   gadgets:=NIL;
  212.   customBitMap:=NIL;
  213.  END;
  214.  myscreen:=OpenScreen (Adr(nuscreen));
  215.  IF myscreen=NIL THEN
  216.   IFFError:=iffOpenScreenfailed
  217.  ELSE
  218.  BEGIN
  219.  
  220.   WITH IFFInfo.IFFCMAP DO
  221.   BEGIN
  222.    FOR i:=0 TO (colorCnt-1) DO
  223.     MySetRGB (Adr(myscreen^.SViewPort),i,red[i],green[i],blue[i],GfxBase);
  224.   END;
  225.  
  226.   WITH nuwindow DO
  227.   BEGIN
  228.    leftEdge:=0;
  229.    topEdge:=0;
  230.    width:=IFFInfo.IFFBMHD.width;
  231.    height:=IFFInfo.IFFBMHD.height;
  232.    detailPen:=1;
  233.    blockPen:=0;
  234.    idcmpFlags:=MOUSEBUTTONS_f;
  235.    flags:=BORDERLESS+NOCAREREFRESH+RMBTRAP+ACTIVATE;
  236.    firstGadget:=NIL;
  237.    checkMark:=NIL;
  238.    title:=NIL;
  239.    screen:=myscreen;
  240.    bitMap:=NIL;
  241.    wtype:=CUSTOMSCREEN_F;
  242.   END;
  243.   mywindow:=OpenWindow (Adr(nuwindow));
  244.   IF mywindow=NIL THEN
  245.   BEGIN
  246.    CloseScreen (myscreen);
  247.    myscreen:=NIL;
  248.    IFFError:=iffOpenWindowFailed;
  249.   END;
  250.  END;
  251. END;
  252.  
  253.  
  254. PROCEDURE ReadQuick (mto : ADDRESS; Count : SHORT ; fake : BOOLEAN);
  255.  
  256. BEGIN
  257.  IF fake=FALSE THEN
  258.   CopyMem (WorkBuffer,mto,Count);
  259.  BufSkip (WorkBuffer,Count);
  260. END;
  261.  
  262.  
  263. PROCEDURE ReadSlow (ato : ADDRESS; Count : SHORT);
  264.  
  265. VAR kk,
  266.     scrRow,
  267.     bCnt    :   INTEGER;
  268.     inCode  :   BYTE;
  269.     ToPtr   :   ^ARRAY [0..9999] OF BYTE;
  270.     DPtr    :   ^ARRAY [0..254] OF BYTE;
  271.     RQBuf   :   BYTE;
  272.     j       :   SHORT;
  273.  
  274. BEGIN
  275.  ToPtr:=ato;
  276.  bCnt:=0;
  277.  WHILE bCnt<Count DO
  278.  BEGIN
  279.   DPtr:=WorkBuffer;
  280.   inCode:=DPtr^[0];
  281.   BufSkip (WorkBuffer,1);
  282.   IF inCode<128 THEN
  283.   BEGIN
  284.    CopyMem (WorkBuffer,Address(Integer(ato)+bCnt),inCode+1);
  285.    BufSkip (WorkBuffer,inCode+1);
  286.    Inc(bCnt,inCode+1);
  287.   END
  288.   ELSE
  289.    IF inCode>128 THEN
  290.    BEGIN
  291.     DPtr:=WorkBuffer;
  292.     RQBuf:=DPTr^[0];
  293.     BufSkip(WorkBuffer,1);
  294.     FOR j:=bCnt TO (bCnt+257-inCode-1) DO
  295.      ToPtr^[j]:=RQBuf;
  296.     Inc(bCnt,257-inCode);
  297.    END;
  298.  END;
  299. END;
  300.  
  301.  
  302. PROCEDURE CheckILBM;
  303.  
  304. BEGIN
  305.  IF StrNEq (TextBuffer,"FORM",4)=FALSE THEN
  306.   IFFError:=iffOpenFailed;
  307.  
  308.  IF (StrNEq (TextBuffer,"FORM",4)=TRUE) AND
  309.     (StrNEq(Address(Integer(TextBuffer)+8),"ILBM",4)=FALSE) THEN
  310.   IFFError:=iffWrongIFF;
  311. END;
  312.  
  313.  
  314. BEGIN
  315.  IFFInfo.IFFTitle:=IFFTitles(0);
  316.  IFFError:=iffnoErr;
  317.  myscreen:=NIL;
  318.  mywindow:=NIL;
  319.  PictureBuffer:=NIL;
  320.  PictureLength:=0;
  321.  contload:=FALSE;
  322.  InH:=DOSOpen (name,MODE_OLDFILE);
  323.  IF InH=NIL THEN
  324.   IFFError:=iffOpenfailed
  325.  ELSE
  326.  BEGIN
  327.   HeaderBuffer:=AllocMem (12,MEMF_CLEAR+MEMF_PUBLIC);
  328.   IF HeaderBuffer<>NIL THEN
  329.   BEGIN
  330.    len:=DOSRead (InH,HeaderBuffer,12);
  331.    IF len<>12 THEN IFFError:=iffReadWriteFailed;
  332.    TEXTBuffer:=HeaderBuffer;
  333.    LONGBuffer:=HeaderBuffer;
  334.    CheckILBM;
  335.  
  336.    PictureLength:=LONGBuffer^[1]-4;
  337.    FreeMem (HeaderBuffer,12);
  338.  
  339.    IF IFFError=iffNoErr THEN
  340.    BEGIN
  341.  
  342.     PictureBuffer:=AllocMem(PictureLength,MEMF_CLEAR+MEMF_PUBLIC);
  343.  
  344.     IF PictureBuffer=NIL THEN
  345.      IFFError:=iffOutofmem
  346.     ELSE
  347.     BEGIN
  348.      len:=DOSRead (InH,PictureBuffer,PictureLength);
  349.      IF InH<>NIL THEN BEGIN DOSClose (InH); InH:=NIL; END;
  350.      IF len<>PictureLength THEN
  351.       IFFError:=iffReadWritefailed
  352.      ELSE
  353.        contload:=TRUE;
  354.      WorkBuffer:=PictureBuffer;
  355.     END;
  356.    END;
  357.   END;
  358.  END;
  359.  IF contload THEN
  360.  BEGIN
  361.   WHILE (IFFError=iffNoErr) AND (contload) DO
  362.   BEGIN
  363.    TextBuffer:=WorkBuffer;
  364.    BufSkip(WorkBuffer,4);
  365.    IF StrNEq (TextBuffer,"BMHD",4) THEN
  366.    BEGIN
  367.     IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR BMHD_f;
  368.     LONGBuffer:=WorkBuffer;
  369.     BufSkip(WorkBuffer,4);
  370.     j:=LONGBuffer^[0];
  371.     SHORTBuffer:=WorkBuffer;
  372.     BYTEBuffer:=WorkBuffer;
  373.     BufSkip(WorkBuffer,j);
  374.     WITH IFFInfo.IFFBMHD DO
  375.     BEGIN
  376.      width:=SHORTBuffer^[0];
  377.      height:=SHORTBuffer^[1];
  378.      left:=SHORTBuffer^[2];
  379.      top:=SHORTBuffer^[3];
  380.      depth:=BYTEBuffer^[8];
  381.      masking:=BYTEBuffer^[9];
  382.      MaskPlane:=(masking=1);
  383.      Compression:=(ByteBuffer^[10]=1);
  384.      transCol:=SHORTBuffer^[6];
  385.      xAspect:=BYTEBuffer^[14];
  386.      yAspect:=BYTEBuffer^[15];
  387.      scrnWidth:=SHORTBuffer^[8];
  388.      scrnHeight:=SHORTBuffer^[9];
  389.     END;
  390.    END
  391.    ELSE
  392.    BEGIN
  393.     IF StrNEq (TextBuffer,"CMAP",4) THEN
  394.     BEGIN
  395.      IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR CMAP_f;
  396.      LONGBuffer:=WorkBuffer;
  397.      BufSkip(WorkBuffer,4);
  398.      i:=LONGBuffer^[0];
  399.      BYTEBuffer:=WorkBuffer;
  400.      BufSkip(WorkBuffer,i);
  401.      WITH IFFInfo.IFFCMAP DO
  402.      BEGIN
  403.       colorcnt:=i DIV 3;
  404.       j:=0;
  405.       FOR k:=0 TO colorcnt-1 DO
  406.       BEGIN
  407.        red[k]:=BYTEBuffer^[j];
  408.        green[k]:=BYTEBuffer^[j+1];
  409.        blue[k]:=BYTEBuffer^[j+2];
  410.        Inc(j,3);
  411.       END;
  412.      END;
  413.     END
  414.     ELSE
  415.     BEGIN
  416.      IF StrNEq (TextBuffer,"CAMG",4) THEN
  417.      BEGIN
  418.       IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR CAMG_f;
  419.       LONGBuffer:=WorkBuffer;
  420.       BufSkip(WorkBuffer,8);
  421.       IFFInfo.IFFCAMG.viewType:=LONGBuffer^[1];
  422.      END
  423.      ELSE
  424.      BEGIN
  425.       IF StrNEq (TextBuffer,"BODY",4) THEN
  426.       BEGIN
  427.        IFFInfo.IFFTitle:=IFFInfo.IFFTitle OR BODY_f;
  428.  
  429.        OpenScrn;
  430.  
  431.        IF IFFError=iffNoErr THEN
  432.        BEGIN
  433.  
  434.         BufSkip (WorkBuffer,4);
  435.  
  436.         IFFBitMap:=myscreen^.SRastPort.BitMap;
  437.         LineLength:=RASSIZE(IFFInfo.IFFBMHD.width,1);
  438.         LineWidth:=IFFBitMap^.BytesPerRow;
  439.  
  440.         IF Compression THEN
  441.         BEGIN
  442.          FOR i:=0 TO (IFFInfo.IFFBMHD.height-1) DO
  443.          FOR j:=0 TO (IFFBitMap^.Depth-1) DO
  444.           ReadSlow (Address(Integer(IFFBitMap^.Planes[j])+(LineWidth*i)),
  445.                     LineLength);
  446.         END
  447.         ELSE
  448.         BEGIN
  449.          FOR i:=0 TO (IFFInfo.IFFBMHD.height-1) DO
  450.          FOR j:=0 TO (IFFBitMap^.Depth-1) DO
  451.           ReadQuick (Address(Integer(IFFBitMap^.Planes[j])+(LineWidth*i)),
  452.                      LineLength,FALSE);
  453.          IF MaskPlane THEN
  454.           ReadQuick (NIL,LineLength,TRUE);
  455.         END;
  456.  
  457.        END;
  458.        contload:=FALSE;
  459.       END
  460.       ELSE
  461.       BEGIN
  462.        LONGBuffer:=WorkBuffer;
  463.        BufSkip (WorkBuffer,4);
  464.        i:=LONGBuffer^[0];
  465.        BufSkip (WorkBuffer,i);
  466.       END;
  467.      END;
  468.     END;
  469.    END;
  470.   END;
  471.  END;
  472.  IF InH<>NIL THEN
  473.   DOSClose (InH);
  474.  IF PictureBuffer<>NIL THEN FreeMem (PictureBuffer,PictureLength);
  475.  IF IFFError<>iffNoErr THEN
  476.  BEGIN
  477.   IF mywindow<>NIL THEN CloseWindow (mywindow);
  478.   IF myscreen<>NIL THEN CloseScreen (myscreen);
  479.   mywindow:=NIL;
  480.   myscreen:=NIL;
  481.  END;
  482.  ReadILBM:=(iffError=iffNoErr);
  483. END;
  484.  
  485.  
  486. BEGIN
  487.  IFFName:=AllocString(255);
  488.  IF IFFName<>NIL THEN
  489.  BEGIN
  490.  
  491.   GetParam(1,IFFName);
  492.  
  493.   IF StrLen (IFFName)>0 THEN
  494.   BEGIN
  495.    GfxBase := OpenLibrary(gfxname, 0);
  496.    WRITELN ("\nIFF-Kurs für AmigaGadget - ein Demo-IFF-Lader");
  497.    WRITELN ("written 1995 by Andreas Neumann":65,"\n");
  498.    IF ReadILBM (IFFName,IFFScreen,IFFWindow) THEN
  499.    BEGIN
  500.     ScreenToFront (IFFScreen);
  501.     REPEAT
  502.      IFFMes:=Address(WaitPort(IFFWindow^.UserPort));
  503.      IFFMes:=Address(GetMsg(IFFWindow^.UserPort));
  504.     UNTIL IFFMes<>NIL;
  505.     ReplyMsg (Address(IFFMes));
  506.     ScreenToBack (IFFScreen);
  507.    END;
  508.  
  509.    IF IFFWindow<>NIL THEN CloseWindow (IFFWindow);
  510.    IF IFFScreen<>NIL THEN CloseScreen (IFFScreen);
  511.    CloseLibrary (GfxBase);
  512.    IF IFFError<>iffNoErr THEN
  513.     WRITELN ("\n",IFFErrorStrings[IFFError],"\n");
  514.   END;
  515.   FreeString (IFFName);
  516.  END;
  517. END.
  518.  
  519.